home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / debug / test.scm < prev    next >
Text File  |  1995-10-13  |  826b  |  33 lines
  1.  
  2. ; ,config ,load debug/test.scm
  3.  
  4. (define-structure testing (export (test :syntax) lost?)
  5.   (open scheme signals handle conditions)
  6.   (begin
  7.  
  8. (define *lost?* #f)
  9. (define (lost?) *lost?*)
  10.  
  11. (define (run-test string compare want thunk)
  12.   (let ((result
  13.      (call-with-current-continuation
  14.        (lambda (k)
  15.          (with-handler (lambda (condition punt)
  16.                  (if (error? condition)
  17.                  (k condition)
  18.                  (punt)))
  19.            thunk)))))
  20.     (if (not (compare want result))
  21.     (begin (display "Test ") (write string) (display " failed.") (newline)
  22.            (display "Wanted ") (write want)
  23.            (display ", but got ") (write result) (display ".")
  24.            (newline)
  25.            (set! *lost?* #t)))))
  26.  
  27. (define-syntax test
  28.   (syntax-rules ()
  29.     ((test ?string ?compare ?want ?exp)
  30.      (run-test ?string ?compare ?want (lambda () ?exp)))))
  31.  
  32. ))
  33.